home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPCOPY.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  4KB  |  124 lines
  1. {┌─────────────────────────────────────────────────────────────────────────┐}
  2. {│                                                                         │}
  3. {│                              T. O. P.                                   │}
  4. {│                                                                         │}
  5. {│                        (T)he  (O)ther  (P)acket                         │}
  6. {│                                                                         │}
  7. {│ T O P C O P Y . P A S                                                   │}
  8. {│                                                                         │}
  9. {│                                                                         │}
  10. {│ Filekopier-Routinen                                                     │}
  11. {└─────────────────────────────────────────────────────────────────────────┘}
  12.  
  13.  
  14. Procedure FileKopieren (* Var Zeile : String *);
  15. Var    i,i1,i2,
  16.        Anzahl    : Integer;
  17.        fq,fz     : File;
  18.        Quelle,
  19.        Ziel      : String[80];
  20.        Hstr,
  21.        Wild      : String;
  22.        FiFlag,
  23.        VerFlag   : Boolean;
  24.        srec      : SearchRec;
  25.        maxPuffer : Word;
  26.  
  27.  
  28.  
  29.     Procedure Kopieren(von,nach : String);
  30.     Var  rResult,
  31.          wResult : Word;
  32.          Attr    : Word;
  33.          FTime   : LongInt;
  34.     Begin
  35.       Assign(fq,von);
  36.       GetFAttr(fq,Attr);
  37.       SetFAttr(fq,$20);
  38.  
  39.       Assign(fz,nach);
  40.       if ResetBin(fq,T) = 0 then
  41.       begin
  42.         GetFTime(fq,FTime);
  43.         if RewriteBin(fz,T) = 0 then
  44.         begin
  45.           Repeat
  46.             Blockread(fq,Page^,maxPuffer,rResult);
  47.             BlockWrite(fz,Page^,rResult,wResult);
  48.           Until Eof(fq);
  49.           SetFTime(fz,FTime);
  50.           FiResult := CloseBin(fz);
  51.           SetFAttr(fz,Attr);
  52.         end else dec(Anzahl);
  53.         FiResult := CloseBin(fq);
  54.       end else dec(Anzahl);
  55.     End;
  56.  
  57. Begin
  58.   if MaxAvail > maxNotChBuf then maxPuffer := maxNotChBuf
  59.                             else maxPuffer := MaxAvail - 1024;
  60.   GetMem(Page,maxPuffer);
  61.   FillChar(Page^,maxPuffer,0);
  62.  
  63.  
  64.   Quelle := CutStr(Zeile);
  65.   Ziel := RestStr(Zeile);
  66.  
  67.   FiFlag := PfadOk(1,Ziel);
  68.   VerFlag := PfadOk(2,Ziel);
  69.  
  70.   if FiFlag or VerFlag then
  71.   begin
  72.     if VerFlag then if Ziel[length(Ziel)] <> BS then Ziel := Ziel + BS;
  73.     Wild := '';
  74.     i := length(Quelle);
  75.     While (length(Quelle) > 0) and (Quelle[length(Quelle)] <> BS) do
  76.     begin
  77.       Wild := Quelle[i] + Wild;
  78.       delete(Quelle,length(Quelle),1);
  79.       dec(i);
  80.     end;
  81.  
  82.     Anzahl := 0;
  83.     FindFirst(Quelle + Wild,AnyFile-Directory,srec);
  84.     While DosError = 0 do
  85.     begin
  86.       inc(Anzahl);
  87.       if VerFlag then
  88.       begin
  89.         Hstr := Ziel + srec.Name;
  90.       end else Hstr := Ziel;
  91.       if Hstr <> (Quelle + srec.Name) then Kopieren(Quelle + srec.Name,Hstr)
  92.                                       else dec(Anzahl);
  93.       Hstr := '';
  94.       FindNext(srec);
  95.     end;
  96.     str(Anzahl,Hstr);
  97.     Zeile := Hstr + B1 + InfoZeile(315);
  98.   end else Zeile := InfoZeile(316);
  99.   FreeMem(Page,maxPuffer);
  100. End;
  101.  
  102.  
  103. Procedure Delete_Datei (* Var Zeile : str80 *);
  104. var    Anzahl   : Word;
  105.        f,fd     : Text;
  106.        Hstr     : String[80];
  107.        srec     : SearchRec;
  108.  
  109. Begin
  110.   Anzahl := 0;
  111.   Hstr := Zeile;
  112.   While (length(Hstr) > 3) and (Hstr[length(Hstr)] <> BS)
  113.   do delete(Hstr,length(Hstr),1);
  114.   if Hstr[length(Hstr)] <> BS then Hstr := '';
  115.   FindFirst(Zeile,AnyFile-Directory,srec);
  116.   While DosError = 0 do
  117.   begin
  118.     Assign(fd,Hstr + srec.Name);
  119.     if EraseTxt(fd) = 0 then inc(Anzahl);
  120.     FindNext(srec);
  121.   end;
  122.   Zeile := int_str(Anzahl) + B1 + InfoZeile(35);
  123. End;
  124.